home *** CD-ROM | disk | FTP | other *** search
/ Megadoom II / MEGADOOM II - iso.7z / MEGADOOM II.ISO / doom / editors / wadfile / d2convrt / dm2conv.pas < prev    next >
Pascal/Delphi Source File  |  1994-12-15  |  30KB  |  1,050 lines
  1. {$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  2. {$M 16384,0,655360}
  3. { DM2CONV v1.2 by Vincenzo Alcamo }
  4. { This program is Public Domain   }
  5. type
  6.   shortname = array[1..3] of char;
  7.   dname = array[1..8] of char;
  8.   p_string = ^string;
  9.   obj = record
  10.     id : integer;
  11.     sname : shortname;
  12.     name : p_string
  13.   end;
  14.   errors = (ERR_OPENS,ERR_READS,ERR_OPEND,ERR_WRITED,ERR_PWAD,
  15.             ERR_TOOENTRY,ERR_TOOMAPS,ERR_NOMAPS,ERR_NOEQ,ERR_BADEND,
  16.             ERR_BADNUM);
  17.   header= record
  18.     Sig   : Longint;
  19.     Num   : Longint;
  20.     Start : Longint;
  21.   end;
  22.   entry = record
  23.     Start : Longint;
  24.     RSize : Longint;
  25.     Name  : dname;
  26.   end;
  27.   thing = record
  28.     xpos : integer;
  29.     ypos : integer;
  30.     angle: integer;
  31.     code : integer;
  32.     flags: integer;
  33.   end;
  34.   sidedef = record
  35.     x,y  : integer;
  36.     a,b,c: dname;
  37.     sect : integer;
  38.   end;
  39.  
  40. const
  41.   show_list : boolean = false;
  42.   show_example: boolean = false;
  43.   show_help : boolean = false;
  44.   show_note : boolean = false;
  45.   nocheck   : boolean = false;
  46.   debug     : boolean = false;
  47.   ignore    : boolean = false;
  48.   do_texture: boolean = false;
  49.   remap_lev : integer = 1;
  50.   remap_mus : integer = 0;
  51.   replaces  : integer = 0;
  52.   BUFFSIZE = 62000;
  53.   MAXENTRY = BUFFSIZE div sizeof(entry);
  54.   MAXTHING = BUFFSIZE div sizeof(thing);
  55.   MAXSIDES = BUFFSIZE div sizeof(sidedef);
  56.   IWAD_SIG = Ord('I')+(Ord('W')+(Ord('A')+Ord('D') shl 8) shl 8) shl 8;
  57.   PWAD_SIG = Ord('P')+(Ord('W')+(Ord('A')+Ord('D') shl 8) shl 8) shl 8;
  58.  
  59.   REP_PERCENT=16384;
  60.   MAXREP=250;
  61.  
  62.   mnames : array[1..32] of dname =  (
  63.     'D_RUNNIN',
  64.     'D_STALKS',
  65.     'D_COUNTD',
  66.     'D_BETWEE',
  67.     'D_DOOM'#0#0,
  68.     'D_THE_DA',
  69.     'D_SHAWN'#0,
  70.     'D_DDTBLU',
  71.     'D_IN_CIT',
  72.     'D_DEAD'#0#0,
  73.     'D_STLKS2',
  74.     'D_THEDA2',
  75.     'D_DOOM2'#0,
  76.     'D_DDTBL2',
  77.     'D_RUNNI2',
  78.     'D_DEAD2'#0,
  79.     'D_STLKS3',
  80.     'D_ROMERO',
  81.     'D_SHAWN2',
  82.     'D_MESSAG',
  83.     'D_COUNT2',
  84.     'D_DDTBL3',
  85.     'D_AMPIE'#0,
  86.     'D_THEDA3',
  87.     'D_ADRIAN',
  88.     'D_MESSG2',
  89.     'D_ROMER2',
  90.     'D_TENSE'#0,
  91.     'D_SHAWN3',
  92.     'D_OPENIN',
  93.     'D_EVIL'#0#0,
  94.     'D_ULTIMA');
  95.  
  96. var
  97.   objects    : array[1..55] of obj;
  98.   replace    : array[1..MAXREP] of word;
  99.   numobjects : integer;
  100.   source     : string;
  101.   dest       : string;
  102.   buffer     : array[1..BUFFSIZE] of byte;
  103.   dirlist    : array[1..MAXENTRY] of entry absolute buffer;
  104.   things     : array[1..MAXTHING] of thing absolute buffer;
  105.   sidedefs   : array[1..MAXSIDES] of sidedef absolute buffer;
  106.   numentry   : integer;
  107.   maxside    : integer;
  108.  
  109.   repside    : word;
  110.   repthing   : word;
  111.   replev     : word;
  112.  
  113. procedure CreateTable; assembler;
  114.   asm
  115.     push ds
  116.     mov ax, SEG objects
  117.     mov es, ax
  118.     lea di, objects
  119.     lea si, @@TABLE
  120.     mov ax, cs
  121.     mov ds, ax
  122.     xor cx, cx
  123.     cld
  124. @@CICLO:
  125.     lodsb
  126.     cmp al, 0
  127.     je  @@STOP
  128.     xor dx, dx
  129. @@NUM:
  130.     mov bx, dx
  131.     add dx, dx
  132.     add dx, dx
  133.     add dx, bx
  134.     add dx, dx
  135.     and ax, 15
  136.     add dx, ax
  137.     lodsb
  138.     cmp al, 32
  139.     jne @@NUM
  140.     push ax
  141.     mov ax, dx
  142.     stosw
  143.     pop ax
  144.  
  145. @@SPACES:
  146.     cmp al, 32
  147.     jne @@SHORT
  148.     lodsb
  149.     jmp @@SPACES
  150. @@SHORT:
  151.     stosb
  152.     movsb
  153.     movsb
  154.     mov bx, si
  155.     inc si
  156. @@ZERO:
  157.     lodsb
  158.     cmp al, 0
  159.     jne @@ZERO
  160.     mov ax, si
  161.     sub ax, bx
  162.     dec ax
  163.     dec ax
  164.     mov ds:[bx], al
  165.     mov ax, bx
  166.     stosw
  167.     mov ax, cs
  168.     stosw
  169.     inc cx
  170.     jmp @@CICLO
  171. @@STOP:
  172.     pop ds
  173.     mov numobjects, cx
  174.     jmp @@FINE
  175. @@TABLE:
  176.     DB '2007 AMM Ammo Clip',0
  177.     DB '68   ARA Arachnotron',0
  178.     DB '64   ARC Archvile',0
  179.     DB '2015 ARM Armor Helmet',0
  180.     DB '8    BAC Backpack',0
  181.     DB '2048 BAM Box of Ammo',0
  182.     DB '2035 BAR Barrel',0
  183.     DB '2023 BER Berserk',0
  184.     DB '2006 BFG BFG9000',0
  185.     DB '2024 BLR Blur Sphere',0
  186.     DB '2019 BLU Blue Armor',0
  187.     DB '3003 BOH Baron of Hell',0
  188.     DB '2046 BRO Box of Rockets',0
  189.     DB '2049 BSH Box of Shells',0
  190.     DB '70   BUR Burning Barrel',0
  191.     DB '3005 CAC Cacodemon',0
  192.     DB '2002 CHA Chaingun',0
  193.     DB '65   CHD Chaingun Dude',0
  194.     DB '2005 CHS Chainsaw',0
  195.     DB '2026 COM Computer Map',0
  196.     DB '16   CYB Cyberdemon',0
  197.     DB '3002 DEM Demon',0
  198.     DB '2047 ENC Energy Cell',0
  199.     DB '17   ENP Energy Pack',0
  200.     DB '2018 GRE Green Armor',0
  201.     DB '2014 HEA Health Potion',0
  202.     DB '69   HEL Hell Knight',0
  203.     DB '3001 IMP Imp',0
  204.     DB '2022 INV Invulnerability',0
  205.     DB '72   KEN Commander Keen',0
  206.     DB '2045 LIG Light Goggles',0
  207.     DB '3006 LOS Lost Soul',0
  208.     DB '67   MAN Mancubus',0
  209.     DB '2012 MED Medikit',0
  210.     DB '83   MEG Megasphere',0
  211.     DB '71   PAI Pain Elemental',0
  212.     DB '2004 PLA Plasma Gun',0
  213.     DB '2025 RAD Radiation Suit',0
  214.     DB '2010 RCK Rocket',0
  215.     DB '66   REV Revenant',0
  216.     DB '2003 ROC Rocket Launcher',0
  217.     DB '9    SER Sergeant',0
  218.     DB '2008 SHE Shells',0
  219.     DB '2001 SHO Shotgun',0
  220.     DB '2013 SOU Soul Sphere',0
  221.     DB '58   SPE Spectre',0
  222.     DB '7    SPI Spiderdemon',0
  223.     DB '82   SSH Super Shotgun',0
  224.     DB '84   SSN SS Nazi',0
  225.     DB '2011 STI Stimpack',0
  226.     DB '3004 TRO Trooper',0
  227.     DB 0
  228. @@FINE:
  229.   end;
  230.  
  231. const processed : byte = 0;
  232. var   numtexture : integer;
  233. procedure Convert(num:integer); assembler;
  234.   asm
  235.     cmp processed, 0
  236.     jne @@DOSEARCH
  237.     inc processed
  238.     lea si, @@TABLE
  239.     xor ax, ax
  240.     mov dx, si
  241. @@CICP:
  242.     inc si
  243.     mov al, cs:[si]
  244.     cmp al, 0
  245.     je  @@FINEP
  246.     cmp al, 32
  247.     jne @@CICP
  248.     mov cs:[si], ah
  249.     jmp @@CICP
  250. @@FINEP:
  251.     mov ax, si
  252.     sub ax, dx
  253.     shr ax, 4
  254.     mov numtexture, ax
  255.     jmp @@FINE
  256. @@DOSEARCH:
  257.     mov cx, num
  258.     lea si, sidedefs
  259.     mov ax, cs
  260.     mov es, ax
  261. @@AGAIN:
  262.     add si, 4
  263.     call @@FIND
  264.     call @@FIND
  265.     call @@FIND
  266.     add si, 2
  267.     loop @@AGAIN
  268.     jmp @@FINE
  269. @@FIND:
  270.     push cx
  271.     push bp
  272.     lea di, @@TABLE
  273.     lodsw
  274.     mov dx, ax
  275.     lodsw
  276.     mov bp, ax
  277.     lodsw
  278.     mov bx, ax
  279.     lodsw
  280.     mov cx, numtexture
  281. @@CICLO:
  282.     cmp dx, es:[di]
  283.     jne @@NEXT
  284.     cmp bp, es:[di+2]
  285.     jne @@NEXT
  286.     cmp bx, es:[di+4]
  287.     jne @@NEXT
  288.     cmp ax, es:[di+6]
  289.     jne @@NEXT
  290.     mov ax, es:[di+8]
  291.     mov [si-8], ax
  292.     mov ax, es:[di+10]
  293.     mov [si-6], ax
  294.     mov ax, es:[di+12]
  295.     mov [si-4], ax
  296.     mov ax, es:[di+14]
  297.     mov [si-2], ax
  298.     inc repside
  299.     jmp @@FOUND
  300. @@NEXT:
  301.     add di, 16
  302.     loop @@CICLO
  303. @@FOUND:
  304.     pop bp
  305.     pop cx
  306.     ret
  307. @@TABLE:
  308.     {TABLE OF TEXTURE REPLACEMENTS}
  309.     DB 'AASTINKYDOORSTOP'
  310.     DB 'ASHWALL ASHWALL2'
  311.     DB 'BLODGR1 PIPE6   '
  312.     DB 'BLODGR2 PIPE6   '
  313.     DB 'BLODGR3 PIPE6   '
  314.     DB 'BLODGR4 PIPE6   '
  315.     DB 'BRNBIGC MIDGRATE'
  316.     DB 'BRNBIGL MIDGRATE'
  317.     DB 'BRNBIGR MIDGRATE'
  318.     DB 'BRNPOIS2BROWN96 '
  319.     DB 'BROVINE BROWN1  '
  320.     DB 'BROWNWELBROWNHUG'
  321.     DB 'CEMPOIS CEMENT1 '
  322.     DB 'COMP2   COMPTALL'
  323.     DB 'COMPOHSOCOMPWERD'
  324.     DB 'COMPTILECOMPWERD'
  325.     DB 'COMPUTE1COMPSTA1'
  326.     DB 'COMPUTE2COMPTALL'
  327.     DB 'COMPUTE3COMPTALL'
  328.     DB 'DOORHI  TEKBRON2'
  329.     DB 'GRAYDANGGRAY5   '
  330.     DB 'ICKDOOR1DOOR1   '
  331.     DB 'ICKWALL6ICKWALL5'
  332.     DB 'LITE2   BROWN1  '
  333.     DB 'LITE4   LITE5   '
  334.     DB 'LITE96  BROWN96 '
  335.     DB 'LITEBLU2LITEBLU1'
  336.     DB 'LITEBLU3LITEBLU1'
  337.     DB 'LITEMET METAL1  '
  338.     DB 'LITERED DOORRED '
  339.     DB 'LITESTONSTONE2  '
  340.     DB 'MIDVINE1MIDGRATE'
  341.     DB 'MIDVINE2MIDGRATE'
  342.     DB 'NUKESLADSLADWALL'
  343.     DB 'PLANET1 COMPSTA2'
  344.     DB 'REDWALL1REDWALL '
  345.     DB 'SKINBORDSKINMET1'
  346.     DB 'SKINTEK1SKINMET2'
  347.     DB 'SKINTEK2SKINMET2'
  348.     DB 'SKULWAL3SKSPINE1'
  349.     DB 'SKULWALLSKSPINE1'
  350.     DB 'SLADRIP1SLADSKUL'
  351.     DB 'SLADRIP2SLADSKUL'
  352.     DB 'SLADRIP3SLADSKUL'
  353.     DB 'SP_DUDE3SP_DUDE4'
  354.     DB 'SP_DUDE6SP_DUDE4'
  355.     DB 'SP_ROCK2SP_ROCK1'
  356.     DB 'STARTAN1STARTAN2'
  357.     DB 'STONGARGSTONE3  '
  358.     DB 'STONPOISSTONE   '
  359.     DB 'TEKWALL2TEKWALL1'
  360.     DB 'TEKWALL3TEKWALL1'
  361.     DB 'TEKWALL5TEKWALL1'
  362.     DB 'WOODSKULWOODGARG'
  363.     DB 0
  364. @@FINE:
  365.   end;
  366.  
  367. {Return a right-padded string of N characters from a string}
  368. function StringN(s:String;n:Integer):String;
  369.   var i:Integer;
  370.   begin
  371.     StringN:=Copy(s,1,n);
  372.     StringN[0]:=Char(n);
  373.     for i:=Length(s)+1 to n do StringN[i]:=' ';
  374.   end;
  375.  
  376. {Converts string to uppercase}
  377. function Upper(s:String):String;
  378.   var i:Integer;
  379.   begin
  380.     Upper[0]:=s[0];
  381.     for i:=1 to Length(s) do Upper[i]:=UpCase(s[i]);
  382.   end;
  383.  
  384. {Add a suffix(extension) to a filename (only if the filename hasn't one)}
  385. function AddSuffix(s,n:String):String;
  386.   var i:Integer;
  387.   begin
  388.     i:=Length(s);
  389.     while i>0 do
  390.       if s[i]='.' then break
  391.       else dec(i);
  392.     if i>0 then AddSuffix:=s
  393.     else AddSuffix:=s+'.'+n;
  394.   end;
  395.  
  396. procedure Title;
  397.   begin
  398.     writeln('DM2CONV v1.2 by Vincenzo Alcamo (alcamo@arci01.bo.cnr.it)');
  399.   end;
  400.  
  401. procedure List;
  402.   var i,j:integer;
  403.   begin
  404.     Title;
  405.     writeln;
  406.     writeln('LIST OF KNOWN OBJECTS');
  407.     for i:=1 to numobjects do begin
  408.       if i mod 3=1 then writeln
  409.       else write('  ');
  410.       with objects[1+((i-1)div 3)+((i-1)mod 3)*((numobjects+2) div 3)] do
  411.         write(id:4,#32,sname,#32,StringN(name^,15));
  412.     end;
  413.     writeln;
  414.     writeln;
  415.     writeln('You can specify an object by its number, its shortname, its name');
  416.     writeln('or even an initial fragment of its name.');
  417.   end;
  418.  
  419. procedure More;
  420.   begin
  421.     Title;
  422.     writeln;
  423.     writeln('REPLACEMENT is an expression specifying object substitution:');
  424.     writeln('  {source}={dest[@num]}');
  425.     writeln('source is the initial object, dest is the final object,');
  426.     writeln('num is the number of substitutions (absolute or percentual)');
  427.     writeln('You can specify more than one replacement.');
  428.     writeln;
  429.     writeln('Replacement expression examples:');
  430.     writeln;
  431.     writeln('DEM=IMP             all Demons become Imps');
  432.     writeln('DEM,IMP=LOS         all Demons and Imps become Lost Souls');
  433.     writeln('DEM=IMP@5           5 Demons become Imps');
  434.     writeln('DEM=IMP@50%         50% of Demons become Imps');
  435.     writeln('DEM=IMP@5,SER       5 Demons become Imps, the rest are Sergeants');
  436.     writeln('DEM=IMP DEM=TRO     No Demons remain for the second expression');
  437.     writeln;
  438.     writeln('Requests greater than available objects are adjusted proportionally:');
  439.     writeln('DEM=IMP@5,TRO@15    If Demons are 9 -> IMP@25%,TRO@75%');
  440.     writeln;
  441.     writeln('You can substitute the % sign with #,$,& whichever you prefer.');
  442.     writeln;
  443.   end;
  444.  
  445. procedure Help;
  446.   begin
  447.     Title;
  448.     writeln('Converts DOOM maps for use with DOOM2.');
  449.     writeln;
  450.     writeln('DM2CONV <input> [output] [/mapnum] [/M[=num]] [/TEXTURE] [/DEBUG]');
  451.     writeln('        [/IGNORE] [/SEED[=num]] [/NOCHECK] [replacements]..');
  452.     writeln('        [/LIST] [/EXAMPLES] [/NOTES] [@response]..');
  453.     writeln;
  454.     writeln('input        name of DOOM wad file to convert ** REQUIRED **');
  455.     writeln('output       name of output file (if omitted, the input file is overwritten)');
  456.     writeln('/mapnum      number for the first level remapped (default: 1)');
  457.     writeln('/M[=num]     music remapping (num is the level for the first music)');
  458.     writeln('/TEXTURE     convert texture names  *** SEE DM2CONV.TXT ***');
  459.     writeln('/DEBUG       display debug information');
  460.     writeln('/IGNORE      make replacements even if no level is remapped');
  461.     writeln('/SEED[=num]  random generator seed (default: 0, randomize if num is omitted)');
  462.     writeln('/NOCHECK     allow the use of object numbers not in list');
  463.     writeln('/LIST        display the list of known objects');
  464.     writeln('/EXAMPLES    display replacements examples');
  465.     writeln('/NOTES       special notes about this program  *** READ THIS ***');
  466.     writeln('@response    response file (text file with additional arguments)');
  467.     writeln;
  468.     writeln('Use /EXAMPLES, /NOTES, /LIST for additional information.');
  469.   end;
  470.  
  471. procedure Notes;
  472.   begin
  473.     Title;
  474.     writeln;
  475.     writeln('Notes about level remapping:');
  476.     writeln('- Level remapping is performed regardless of level name:');
  477.     writeln('  the first level found becomes MAP01 (and so on)');
  478.     writeln('- No other resources are remapped (eg: M_EPI?, etc...)');
  479.     writeln('- DM2CONV acts only in one way: keep a backup of your wads.');
  480.     writeln('- Secret levels are not remapped to the proper level: don''t use wads');
  481.     writeln('  with secret levels  or, at least, avoid entering a secret level.');
  482.     writeln;
  483.     writeln('Music remapping has 3 settings (none, /M, /M=num):');
  484.     writeln('1) no music is remapped.');
  485.     writeln('2) remap musics accordingly to remapped levels');
  486.     writeln('   D_E1M1 becomes D_RUNNIN only if E1M1 was remapped');
  487.     writeln('3) the first music found becomes the music for MAP num,');
  488.     writeln('   the second becomes the music for MAP num+1, and so on.');
  489.     writeln('For 2) and 3): the end-of-level music is also remapped.');
  490.   end;
  491.  
  492. function GetWord(var s:string):string;
  493.   var i:integer;
  494.   begin
  495.     s:=s+':';
  496.     i:=1;
  497.     while ((s[i]>='0') and (s[i]<='9')) or ((s[i]>='A') and (s[i]<='Z')) do inc(i);
  498.     GetWord:=Copy(s,1,i-1);
  499.     s:=Copy(s,i,length(s)-i);
  500.   end;
  501.  
  502. function GetNum(var s:string):integer;
  503.   var i,j,k:integer;
  504.   begin
  505.     val(s,j,k);
  506.     if k=0 then begin
  507.       if nocheck and (j>0) and (j<16384) then begin
  508.         GetNum:=j;
  509.         exit;
  510.       end;
  511.       for i:=1 to numobjects do
  512.         if objects[i].id=j then begin
  513.           GetNum:=j;
  514.           exit;
  515.         end;
  516.     end
  517.     else begin
  518.       for i:=1 to numobjects do
  519.         if s=objects[i].sname then begin
  520.           GetNum:=objects[i].id;
  521.           exit;
  522.         end;
  523.       for i:=1 to numobjects do with objects[i] do begin
  524.         j:=1;
  525.         k:=1;
  526.         repeat
  527.           if name^[k]=' ' then inc(k)
  528.           else if s[j]<>UpCase(name^[k]) then break
  529.           else begin
  530.             inc(j);
  531.             inc(k);
  532.           end;
  533.         until (j>length(s)) or (k>length(name^));
  534.         if j>length(s) then begin
  535.           GetNum:=id;
  536.           exit;
  537.         end;
  538.       end;
  539.     end;
  540.     GetNum:=0;
  541.   end;
  542.  
  543. procedure noname(s:string);
  544.   begin
  545.     writeln('No object found for ',s);
  546.     halt;
  547.   end;
  548.  
  549. procedure myhalt(code:errors);
  550.   begin
  551.     case code of
  552.       ERR_OPENS: writeln('Error opening source: ',source);
  553.       ERR_OPEND: writeln('Error opening destination: ',dest);
  554.       ERR_READS: writeln('Error reading source: ',source);
  555.       ERR_WRITED:writeln('Error writing destination: ',dest);
  556.       ERR_PWAD:  writeln('File is not a PWAD: ',source);
  557.       ERR_TOOENTRY:writeln('Too many entries in file: ',source);
  558.       ERR_TOOMAPS:writeln('Cannot remap after map 32');
  559.       ERR_NOMAPS:writeln('No maps found in file: ',source);
  560.       ERR_NOEQ:  writeln('Missing ''='' after list of source objects');
  561.       ERR_BADEND:writeln('Expression incorrectly terminated');
  562.       ERR_BADNUM:writeln('Bad number in expression');
  563.     end;
  564.     halt(0);
  565.   end;
  566.  
  567. procedure Swappa(var h,k:integer);
  568.   var l:integer;
  569.   begin
  570.     l:=replace[k];
  571.     replace[k]:=replace[h];
  572.     replace[h]:=l;
  573.     inc(k);
  574.     inc(h);
  575.     l:=replace[k];
  576.     replace[k]:=replace[h];
  577.     replace[h]:=l;
  578.     inc(k);
  579.     inc(h);
  580.   end;
  581.  
  582. procedure Parse;
  583.   var
  584.     i,j,k,h : integer;
  585.     s,t     : string;
  586.     l       : longint;
  587.     f       : boolean;
  588.     repn    : integer;
  589.     ri,rc,rs: integer;
  590.     response: text;
  591.     inresp  : boolean;
  592.     respstr : string;
  593.   function GetArgument:string;
  594.     var i,j:integer;
  595.     begin
  596.       if respstr='' then begin
  597.         if eof(response) then begin
  598.           respstr:='';
  599.           inresp:=false;
  600.           close(response);
  601.         end
  602.         else begin
  603.           Readln(response,respstr);
  604.           if ioresult<>0 then begin
  605.             writeln('Error reading from response file');
  606.             respstr:='';
  607.             inresp:=false;
  608.             close(response);
  609.           end;
  610.           j:=1;
  611.           for i:=1 to length(respstr) do
  612.             case respstr[i] of
  613.               #32,#9: if j>1 then begin
  614.                         respstr[j]:=#32;
  615.                         inc(j);
  616.                       end;
  617.               else begin
  618.                 respstr[j]:=respstr[i];
  619.                 inc(j);
  620.               end;
  621.             end;
  622.           respstr[0]:=chr(j-1);
  623.         end;
  624.       end;
  625.       case respstr[1] of
  626.         '''',';','#','%': respstr:='';
  627.       end;
  628.       i:=1;
  629.       while (i<=length(respstr)) and (respstr[i]<>#32) do inc(i);
  630.       GetArgument:=Upper(Copy(respstr,1,i-1));
  631.       respstr:=Copy(respstr,i+1,255);
  632.     end;
  633.   begin
  634.     source:='';
  635.     dest:='';
  636.     RandSeed:=0;
  637.     repn:=1;
  638.     inresp:=false;
  639.     i:=1;
  640.     while i<=ParamCount do begin
  641.       f:=not (show_help or show_example or show_list or show_note);
  642.       if inresp then s:=GetArgument
  643.       else s:=Upper(ParamStr(i));
  644.       if s='' then {DO NOTHING}
  645.       else if s[1]='@' then begin
  646.         if inresp then writeln('Cannot use nested response file!')
  647.         else begin
  648.           respstr:='';
  649.           assign(response,Copy(s,2,255));
  650.           reset(response);
  651.           if ioresult<>0 then writeln('Error opening response file.')
  652.           else inresp:=true;
  653.         end;
  654.       end
  655.       else if (s[1]='/') or (s[1]='-') then begin
  656.         s:=Copy(s,2,255);
  657.         if (s='HELP') or (s='?') or (s='H') then show_help:=f
  658.         else if (s='NOCHECK') or (s='N') then nocheck:=True
  659.         else if (s='LIST') or (s='L') then show_list:=f
  660.         else if (Copy(s,1,7)='EXAMPLE') or (s='E') then show_example:=f
  661.         else if Copy(s,1,4)='NOTE' then show_note:=f
  662.         else if (s='DEBUG') or (s='D') then debug:=True
  663.         else if (s='IGNORE') or (s='I') then ignore:=True
  664.         else if (s='TEXTURE') or (s='T') then do_texture:=True
  665.         else if Copy(s,1,4)='SEED' then begin
  666.           s:=Copy(s,5,255);
  667.           j:=0;
  668.           if s[1]='=' then begin
  669.             s:=Copy(s,2,255);
  670.             Val(s,l,j);
  671.             if j<>0 then writeln('Bad number for seed: ',s)
  672.             else RandSeed:=l;
  673.           end
  674.           else Randomize;
  675.           if j=0 then writeln('Seed for random generator is: ',RandSeed);
  676.         end
  677.         else if s[1]='M' then begin
  678.           s:=Copy(s,2,255);
  679.           if s[1]='=' then s:=Copy(s,2,255);
  680.           if Length(s)>0 then begin
  681.             Val(s,j,k);
  682.             if (k<>0) or (j<1) or (j>32) then writeln('Bad number for music: ',s)
  683.             else remap_mus:=j;
  684.           end
  685.           else remap_mus:=-1; {remap level&music}
  686.         end
  687.         else begin
  688.           Val(s,j,k);
  689.           if (k<>0) or (j<1) or (j>32) then writeln('Bad number for remap: ',s)
  690.           else begin
  691.             remap_lev:=j;
  692.             writeln('Remapping from level ',j);
  693.           end;
  694.         end
  695.       end
  696.       else begin
  697.         k:=0;
  698.         for j:=1 to length(s) do if s[j]='=' then k:=1;
  699.         if k=0 then begin
  700.           if source='' then source:=s
  701.           else if dest='' then dest:=s
  702.           else writeln('Extra parameter ignored: ',s);
  703.         end
  704.         else begin
  705.           inc(replaces);
  706.           if debug then writeln('Replacement ',replaces,': ',s);
  707.           rs:=repn;
  708.           s:=','+s+'';
  709.           while s[1]=',' do begin
  710.             s:=Copy(s,2,255);
  711.             t:=GetWord(s);
  712.             j:=GetNum(t);
  713.             if j=0 then noname(t);
  714.             replace[repn]:=j;
  715.             inc(repn);
  716.           end;
  717.           if s[1]<>'=' then myhalt(ERR_NOEQ);
  718.           ri:=repn;
  719.           inc(repn);
  720.           rc:=0;
  721.           s[1]:=',';
  722.           while s[1]=',' do begin
  723.             s:=Copy(s,2,255);
  724.             t:=GetWord(s);
  725.             j:=GetNum(t);
  726.             if j=0 then noname(t);
  727.             replace[repn]:=j;
  728.             inc(repn);
  729.             replace[repn]:=0;
  730.             if s[1]='@' then begin
  731.               s:=Copy(s,2,255);
  732.               t:=GetWord(s);
  733.               val(t,j,k);
  734.               if (k<>0) or (j>=REP_PERCENT) or (j<=0) then myhalt(ERR_BADNUM);
  735.               if (s[1]>='#') and (s[1]<='&') then begin
  736.                 inc(j,REP_PERCENT);
  737.                 s:=Copy(s,2,255);
  738.               end;
  739.               replace[repn]:=j;
  740.             end;
  741.             inc(repn);
  742.             inc(rc);
  743.           end;
  744.           if (s[1]<>'') or (rc=0) then myhalt(ERR_BADEND);
  745.           replace[ri]:=REP_PERCENT+rc;
  746.           k:=ri+1;
  747.           for j:=1 to rc do begin
  748.             h:=ri+j*2-1;
  749.             if (replace[h+1]>0) and (replace[h+1]<REP_PERCENT) then Swappa(h,k);
  750.           end;
  751.           for j:=1 to rc do begin
  752.             h:=ri+j*2-1;
  753.             if replace[h+1]>=REP_PERCENT then Swappa(h,k);
  754.           end;
  755.           if debug then begin
  756.             write('REPLACE');
  757.             for j:=rs to ri-1 do write(' ',replace[j]);
  758.             write(' WITH');
  759.             for j:=1 to rc do begin
  760.               k:=ri+j*2-1;
  761.               write(' ',replace[k]);
  762.               if replace[k+1]>0 then
  763.                 if replace[k+1]>=REP_PERCENT then write('@',replace[k+1]-REP_PERCENT,'%')
  764.                 else write('@',replace[k+1]);
  765.             end;
  766.             writeln;
  767.           end;
  768.         end;
  769.       end;
  770.  
  771.       if not inresp then inc(i);
  772.     end;
  773.     if not (show_example or show_list or show_note) and (source='') then show_help:=true;
  774.     source:=AddSuffix(source,'WAD');
  775.     if dest<>'' then dest:=AddSuffix(dest,'WAD');
  776.   end;
  777.  
  778. procedure CopyDest;
  779.   var a,b     : file;
  780.       l       : Longint;
  781.       size,len: Word;
  782.   begin
  783.     writeln('Copying source to destination...');
  784.     Assign(a,source);
  785.     FileMode:=0;  {open for read only}
  786.     Reset(a,1);
  787.     FileMode:=2;  {open for read/write}
  788.     if ioresult<>0 then myhalt(ERR_OPENS);
  789.     Assign(b,dest);
  790.     Rewrite(b,1);
  791.     if ioresult<>0 then myhalt(ERR_OPEND);
  792.     l:=FileSize(a);
  793.     while l>0 do begin
  794.       if l>BUFFSIZE then size:=BUFFSIZE
  795.       else size:=l;
  796.       BlockRead(a,buffer,size,len);
  797.       if (ioresult<>0) or (size<>len) then myhalt(ERR_READS);
  798.       BlockWrite(b,buffer,size,len);
  799.       if (ioresult<>0) or (size<>len) then myhalt(ERR_WRITED);
  800.       dec(l,size);
  801.     end;
  802.     Close(a);
  803.     Close(b);
  804.   end;
  805.  
  806. procedure ReplaceThings(totobj:Integer);
  807.   var index  : array[1..4000] of integer;
  808.       numobj : integer;
  809.       i,j,k,l: integer;
  810.       repn,h : integer;
  811.       numabs : integer;
  812.       nabs   : integer;
  813.       nrel   : integer;
  814.       s      : string;
  815.   procedure Choose(var max:integer;n,c:integer);
  816.     var i,j:integer;
  817.     begin
  818.       if n<max then begin
  819.         for i:=1 to n do begin
  820.           j:=Random(max)+1;
  821.           with things[index[j]] do begin
  822.             if code<>c then inc(repthing);
  823.             code:=c;
  824.           end;
  825.           index[j]:=index[max];
  826.           dec(max);
  827.         end;
  828.       end
  829.       else begin
  830.         for i:=1 to max do with things[index[i]] do begin
  831.           if code<>c then inc(repthing);
  832.           code:=c;
  833.         end;
  834.         max:=0;
  835.       end;
  836.     end;
  837.   begin
  838.     repn:=1;
  839.     for i:=1 to replaces do begin
  840.       if debug then write('REPLACEMENT=',i);
  841.       numobj:=0;
  842.       while replace[repn]<REP_PERCENT do begin
  843.         j:=replace[repn];
  844.         for k:=1 to totobj do
  845.           if things[k].code=j then begin
  846.             inc(numobj);
  847.             index[numobj]:=k;
  848.           end;
  849.         inc(repn);
  850.       end;
  851.       if debug then write('  TOTAL OBJECTS=',numobj);
  852.       nabs:=0;
  853.       nrel:=replace[repn]-REP_PERCENT;
  854.       inc(repn);
  855.       if numobj=0 then begin
  856.         if debug then writeln('   SKIPPED');
  857.         inc(repn,nrel+nrel);
  858.         continue;
  859.       end;
  860.       numabs:=0;
  861.       j:=nrel;
  862.       l:=repn+1;
  863.       k:=1;
  864.       while (k<=j) do begin
  865.         if replace[l]=0 then replace[l]:=REP_PERCENT
  866.         else begin
  867.           if replace[l]>=REP_PERCENT then
  868.             replace[l]:=(longint(numobj)*(replace[l]-REP_PERCENT)+50)div 100;
  869.           inc(numabs,replace[l]);
  870.           inc(nabs);
  871.           dec(nrel);
  872.         end;
  873.         inc(k);
  874.         inc(l,2);
  875.       end;
  876.       if numabs>numobj then begin
  877.         l:=repn+1;
  878.         k:=numobj;
  879.         for j:=1 to nabs do begin
  880.           h:=replace[l];
  881.           replace[l]:=(longint(h)*k+numabs div 2)div numabs;
  882.           dec(numabs,h);
  883.           dec(k,replace[l]);
  884.           inc(l,2);
  885.         end;
  886.         numabs:=numobj;
  887.       end;
  888.       l:=repn+nabs*2+1;
  889.       numabs:=numobj-numabs;
  890.       while nrel>0 do begin
  891.         j:=(numabs+nrel div 2) div nrel;
  892.         replace[l]:=j;
  893.         dec(numabs,j);
  894.         inc(l,2);
  895.         dec(nrel);
  896.         inc(nabs);
  897.       end;
  898.       for j:=1 to nabs do begin
  899.         if debug then begin
  900.           if j mod 4=1 then writeln
  901.           else write(#32);
  902.           k:=numobjects;
  903.           h:=replace[repn];
  904.           while (k>0) and (objects[k].id<>h) do dec(k);
  905.           if k<>0 then s:=objects[k].name^
  906.           else begin
  907.             Str(h,s);
  908.             s:='Unknown #'+s;
  909.           end;
  910.           write(s:15,'=');
  911.           Str(replace[repn+1],s);
  912.           write(StringN(s,3));
  913.         end;
  914.         Choose(numobj,replace[repn+1],replace[repn]);
  915.         inc(repn,2);
  916.       end;
  917.       if debug then writeln;
  918.     end;
  919.   end;
  920.  
  921. procedure Plural(n:integer;s:string);
  922.   begin
  923.     write(' ',n,' ',s);
  924.     if n<>1 then write('s');
  925.   end;
  926.  
  927. procedure Process;
  928.   var f    : file;
  929.       head : header;
  930.       size : integer;
  931.       i,j,k: integer;
  932.       numt : integer;
  933.       fpos : longint;
  934.       rlev : array[1..27] of integer;
  935.   begin
  936.     repside:=0;
  937.     repthing:=0;
  938.     replev:=0;
  939.     for i:=1 to 27 do rlev[i]:=0;
  940.     if dest<>'' then CopyDest
  941.     else dest:=source;
  942.     source:=dest;
  943.     Assign(f,dest);
  944.     Reset(f,1);
  945.     if ioresult<>0 then myhalt(ERR_OPEND);
  946.     BlockRead(f,head,sizeof(header),size);
  947.     if (ioresult<>0) or (size<>sizeof(header)) then myhalt(ERR_READS);
  948.     if head.sig<>PWAD_SIG then myhalt(ERR_PWAD);
  949.     numentry:=head.num;
  950.     if numentry>MAXENTRY then myhalt(ERR_TOOENTRY);
  951.     Seek(f,head.start);
  952.     if ioresult<>0 then myhalt(ERR_READS);
  953.     BlockRead(f,dirlist,numentry*sizeof(entry),size);
  954.     if (ioresult<>0) or (size<>numentry*sizeof(entry)) then myhalt(ERR_READS);
  955.     for i:=1 to numentry do with dirlist[i] do begin
  956.       if (name[1]='E') and (name[3]='M') then begin
  957.         if remap_lev>32 then myhalt(ERR_TOOMAPS);
  958.         rlev[(ord(name[2])-49)*9+ord(name[4])-48]:=remap_lev;
  959.         name[1]:='M';
  960.         name[2]:='A';
  961.         name[3]:='P';
  962.         name[4]:=chr(remap_lev div 10+48);
  963.         name[5]:=chr(remap_lev mod 10+48);
  964.         inc(remap_lev);
  965.         inc(replev);
  966.       end;
  967.     end;
  968.     j:=0;
  969.     if remap_mus<>0 then
  970.       for i:=1 to numentry do with dirlist[i] do
  971.         if (name[1]='D') and (name[2]='_') then
  972.           if name='D_INTER'#0 then name:='D_DM2INT'
  973.           else if (name[3]='E') and (name[5]='M') then
  974.             if remap_mus>0 then begin
  975.               if remap_mus>32 then myhalt(ERR_TOOMAPS);
  976.               name:=mnames[remap_mus];
  977.               inc(remap_mus);
  978.               inc(j);
  979.             end
  980.             else begin
  981.               k:=rlev[(ord(name[4])-49)*9+ord(name[6])-48];
  982.               if k>0 then name:=mnames[k];
  983.             end;
  984.  
  985.     if (replev=0) and (j=0) and not ignore then myhalt(ERR_NOMAPS);
  986.     Seek(f,head.start);
  987.     if ioresult<>0 then myhalt(ERR_WRITED);
  988.     BlockWrite(f,dirlist,numentry*sizeof(entry),size);
  989.     if (ioresult<>0) or (size<>numentry*sizeof(entry)) then myhalt(ERR_WRITED);
  990.     numt:=MAXENTRY+1;
  991.     for i:=numentry downto 1 do
  992.       if ((replaces>0) and (dirlist[i].Name='THINGS'#0#0)) or
  993.          (do_texture and (dirlist[i].Name='SIDEDEFS')) then begin
  994.         dec(numt);
  995.         dirlist[numt]:=dirlist[i];
  996.       end;
  997.     if numt<=MAXENTRY then begin
  998.       writeln('Processing REPLACEMENTS...');
  999.       maxside:=(longint(numt-1)*sizeof(entry))div sizeof(sidedef);
  1000.       for i:=numt to MAXENTRY do with dirlist[i] do begin
  1001.         Seek(f,start);
  1002.         if ioresult<>0 then myhalt(ERR_READS);
  1003.         if name='SIDEDEFS' then begin
  1004.           k:=rsize div sizeof(sidedef);
  1005.           while k>0 do begin
  1006.             j:=maxside;
  1007.             if j>k then j:=k;
  1008.             fpos:=FilePos(f);
  1009.             BlockRead(f,sidedefs,j*sizeof(sidedef),size);
  1010.             if (ioresult<>0) or (size<>j*sizeof(sidedef)) then myhalt(ERR_READS);
  1011.             Convert(j);
  1012.             Seek(f,fpos);
  1013.             if ioresult<>0 then myhalt(ERR_WRITED);
  1014.             BlockWrite(f,sidedefs,j*sizeof(sidedef),size);
  1015.             if (ioresult<>0) or (size<>j*sizeof(sidedef)) then myhalt(ERR_WRITED);
  1016.             dec(k,j);
  1017.           end;
  1018.         end
  1019.         else begin
  1020.           BlockRead(f,things,rsize,size);
  1021.           if (ioresult<>0) or (size<>rsize) then myhalt(ERR_READS);
  1022.           ReplaceThings(rsize div sizeof(thing));
  1023.           Seek(f,start);
  1024.           if ioresult<>0 then myhalt(ERR_WRITED);
  1025.           BlockWrite(f,things,rsize,size);
  1026.           if (ioresult<>0) or (size<>rsize) then myhalt(ERR_WRITED);
  1027.         end;
  1028.       end;
  1029.     end;
  1030.     Close(f);
  1031.     write('Operation completed: converted');
  1032.     Plural(replev,'level');
  1033.     write(',');
  1034.     Plural(repside,'texture');
  1035.     write(',');
  1036.     Plural(repthing,'object');
  1037.     writeln('.');
  1038.   end;
  1039.  
  1040. begin
  1041.   CreateTable;
  1042.   Convert(0);
  1043.   Parse;
  1044.   if show_help then Help
  1045.   else if show_list then List
  1046.   else if show_example then More
  1047.   else if show_note then Notes
  1048.   else Process;
  1049. end.
  1050.